home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr21
/
spkrdsgn.zip
/
SPEAKER.BAS
next >
Wrap
BASIC Source File
|
1993-05-03
|
15KB
|
509 lines
DECLARE FUNCTION ltr2cf! (ltr!)
DECLARE FUNCTION ci2cf! (ci!)
DECLARE SUB prtInfo (type$, resonance!, Qtc!)
DECLARE SUB makeSealed ()
DECLARE SUB makePorted ()
DECLARE SUB makeIsobarik ()
DECLARE SUB header ()
DECLARE SUB enterData ()
DECLARE SUB storeMenu (yn$, a$)
DECLARE SUB saveData ()
DECLARE SUB another (yn$)
DECLARE SUB tryToFit ()
DECLARE SUB sysTypeMenu ()
DECLARE SUB escConfirm (YorN$)
DECLARE SUB enterSearchParms ()
DECLARE SUB getDataMatch (Manu$, Model$, retFlag)
DECLARE SUB showData ()
DECLARE SUB matchedData ()
DECLARE SUB spkrDataBox ()
DECLARE SUB cantFind ()
DECLARE SUB entryError ()
DECLARE SUB box (X1%, Y1%, X2%, Y2%)
DECLARE SUB clrTop ()
DECLARE SUB clrBottom ()
DECLARE FUNCTION PdB! (Qtc!)
DECLARE FUNCTION FxMax! (Qtc!)
DECLARE FUNCTION FgMax! (FxMax!)
DECLARE FUNCTION Alpha! (Qtc!, Qts!)
DECLARE FUNCTION Fc! (Qtc!, Qts!, Fs!)
DECLARE FUNCTION F3! (Qtc!, Fc!)
DECLARE FUNCTION Vb! (Vas!, Alpha!)
DECLARE FUNCTION Lv! (Dv!, Vb!, Fb!)
TYPE drivParm
Manuf AS STRING * 20
Model AS STRING * 10
Size AS STRING * 10
Vas AS SINGLE
Qts AS SINGLE
Fs AS SINGLE
PwrRms AS INTEGER
END TYPE
TYPE enclParm
Nm AS STRING * 20
drvr AS drivParm
Vol AS SINGLE
VentDiam AS SINGLE
VentLen AS SINGLE
Cutoff AS SINGLE
END TYPE
COMMON SHARED drvr AS drivParm
COMMON SHARED oldDrvr AS drivParm
COMMON SHARED encl AS enclParm
COMMON SHARED mask1 AS STRING * 8
COMMON SHARED mask2 AS STRING * 6
mask1 = "#.## &"
mask2 = "## &"
ON ERROR GOTO errorHandler
header
DO 'MAIN MENU
clrTop
clrBottom
box 8, 23, 14, 56
LOCATE 9, 25: PRINT "1. E)nter driver data"
LOCATE 10, 25: PRINT "2. G)et driver data from disk"
LOCATE 11, 25: PRINT "3. F)it to critical parameters"
LOCATE 13, 40: PRINT "<Esc>=quit"
DO
a$ = INKEY$
LOOP WHILE a$ = ""
SELECT CASE a$
CASE "1", "E", "e": enterData
CASE "2", "G", "g": enterSearchParms
CASE "3", "F", "f": tryToFit
CASE CHR$(27): escConfirm YorN$
SELECT CASE YorN$
CASE "N", "n": a$ = ""
CASE "Y", "y": VIEW PRINT 1 TO 23: CLS : END
END SELECT
CASE ELSE: entryError
END SELECT
LOOP UNTIL a$ = CHR$(27)
END
errorHandler:
clrBottom
box 20, 10, 22, 70
COLOR 30
BEEP
SELECT CASE ERR
CASE 6: LOCATE 21, 12: PRINT ERR: LOCATE 21, 23: PRINT "Number too large! Re-enter please"
CASE 11: LOCATE 21, 12: PRINT ERR: LOCATE 21, 26: PRINT "Attempted division by zero!"
CASE 13: LOCATE 21, 12: PRINT ERR: LOCATE 21, 28: PRINT "Input wrong data type!"
CASE 24, 25, 27: LOCATE 21, 12: PRINT ERR: LOCATE 21, 31: PRINT "Printer not ready!"
CASE 51: LOCATE 21, 12: PRINT ERR: LOCATE 21, 28: PRINT "Qbasic system failure!!": SLEEP 2: END
CASE 53, 75, 76: LOCATE 21, 12: PRINT ERR: LOCATE 21, 29: PRINT "Cannot find data file!": SLEEP 2: END
CASE 57: LOCATE 21, 12: PRINT ERR: LOCATE 21, 27: PRINT "I/O error, unrecoverable!": SLEEP 2: END
CASE 61: LOCATE 21, 12: PRINT ERR: LOCATE 21, 35: PRINT "Disk Full!"
CASE ELSE: LOCATE 21, 12: PRINT ERR: LOCATE 21, 25: PRINT "Unknown error, unrecoverable!": SLEEP 2: END
END SELECT
COLOR 7
SLEEP 3
clrBottom
box 20, 10, 22, 70
LOCATE 21, 22: PRINT "Press any key when ready to continue"
DO
a$ = INKEY$
LOOP WHILE a$ = ""
RESUME 0
FUNCTION Alpha! (Qtc!, Qts!)
Alpha! = (Qtc! / Qts!) ^ 2 - 1
END FUNCTION
SUB another (yn$)
DO
clrBottom
box 20, 32, 22, 48
LOCATE 21, 33: PRINT "Another? (Y/N)"
DO
yn$ = INKEY$
LOOP WHILE yn$ = ""
SELECT CASE yn$
CASE "y", "Y", "n", "N", CHR$(27)
CASE ELSE
clrBottom
box 20, 29, 22, 51
LOCATE 21, 32: PRINT "Please select Y or N"
SLEEP 1
END SELECT
LOOP UNTIL UCASE$(yn$) = "Y" OR UCASE$(yn$) = "N" OR yn$ = CHR$(27)
END SUB
SUB box (X1%, Y1%, X2%, Y2%) 'Builds single-line box
ULC$ = CHR$(218) '┌
URC$ = CHR$(191) '┐
LLC$ = CHR$(192) '└
LRC$ = CHR$(217) '┘
VL$ = CHR$(179) '│
HL$ = CHR$(196) '─
LOCATE X1%, Y1% 'place a ┌ at X1,Y1
PRINT ULC$;
FOR y = (Y1% + 1) TO (Y2% - 1)'draws horizontal line with ─'s
LOCATE X1%, y
PRINT HL$;
NEXT y
PRINT URC$; 'place a ┐ at end of line
FOR x = (X1% + 1) TO (X2% - 1)'plots │'s downward. Left then right
LOCATE x, Y1%
PRINT VL$;
LOCATE x, Y2%
PRINT VL$
NEXT x
LOCATE X2%, Y1% 'place a └ at X2,Y1
PRINT LLC$
FOR yy = (Y1% + 1) TO (Y2% - 1)'draw horizontal line of ─'s for bottom
LOCATE X2%, yy
PRINT HL$
NEXT yy
LOCATE X2%, Y2% 'place final ┘ at X2,Y2
PRINT LRC$
END SUB
SUB cantFind
clrBottom
box 20, 29, 22, 51
COLOR 13
BEEP
LOCATE 21, 30: PRINT "Cannot locate driver"
COLOR 7
SLEEP 1
clrBottom
END SUB
FUNCTION ci2cf (ci!)
ci2cf = ci! / 1728
END FUNCTION
SUB clrBottom
VIEW PRINT 20 TO 23
CLS
VIEW PRINT 4 TO 23
END SUB
SUB clrTop
VIEW PRINT 4 TO 19
CLS
VIEW PRINT 4 TO 23
END SUB
SUB enterData
DO
CLS
spkrDataBox
LOCATE 15, 24: PRINT "Press <Enter> for all to exit"
LOCATE 7, 36, , 3, 10: INPUT "", drvr.Manuf
LOCATE 8, 36: INPUT "", drvr.Model
LOCATE 9, 36: INPUT "", drvr.Size
LOCATE 10, 36: INPUT "", drvr.Vas
LOCATE 11, 36: INPUT "", drvr.Qts
LOCATE 12, 36: INPUT "", drvr.Fs
LOCATE 13, 36: INPUT "", drvr.PwrRms
LOCATE , , 0
IF drvr.Qts = 0 AND drvr.Fs = 0 AND drvr.Vas = 0 THEN EXIT DO
storeMenu yn$, a$
LOOP UNTIL yn$ = "n" OR yn$ = "N" OR yn$ = CHR$(27) OR a$ = CHR$(27)
END SUB
SUB enterSearchParms
CLS
box 9, 25, 12, 55
LOCATE 10, 26: PRINT "Manuf :"
LOCATE 11, 26: PRINT "Model :"
LOCATE 10, 34: INPUT "", Manu$
LOCATE 11, 34: INPUT "", Model$
IF Manu$ = "" AND Model$ = "" THEN EXIT SUB
getDataMatch Manu$, Model$, flag
SELECT CASE flag
CASE 1
showData
CASE ELSE
cantFind
END SELECT
END SUB
SUB entryError
clrBottom
box 20, 33, 22, 45
LOCATE 21, 34
COLOR 13
PRINT "Entry error"
COLOR 7
BEEP
FOR x = 1 TO 300: NEXT x
END SUB
SUB escConfirm (YorN$)
box 20, 28, 22, 51
COLOR 13
LOCATE 21, 30: PRINT "Are you sure? (Y/N)"
COLOR 7
DO
YorN$ = INKEY$
LOOP UNTIL (YorN$ <> "")
LOCATE 21, 55: PRINT YorN$
SLEEP 1
LOCATE 21, 55: PRINT " "
IF YorN$ <> "Y" AND YorN$ <> "y" AND YorN$ <> "N" AND YorN$ <> "n" THEN
BEEP
COLOR 30
LOCATE 21, 30: PRINT "Select Y or N please"
COLOR 7
SLEEP 1
escConfirm YorN$
END IF
END SUB
FUNCTION F3! (Qtc!, Fc!)
F3! = ((ABS((((1 / (Qtc! ^ 2)) - 2) + (((((1 / (Qtc! ^ 2)) - 2) ^ 2) + 4) ^ .5)) / 2)) ^ .5) * Fc!
END FUNCTION
FUNCTION Fc! (Qtc!, Qts!, Fs!)
Fc! = (Qtc! * Fs!) / Qts!
END FUNCTION
FUNCTION FgMax! (FxMax!)
FgMax! = 1 / FxMax!
END FUNCTION
FUNCTION FxMax! (Qtc!)
FxMax! = (1 - (1 / (2 * (Qtc! ^ 2)))) ^ .5
END FUNCTION
SUB getDataMatch (Manu$, Model$, retFlag)
OPEN "c:\SPEAKER.DAT" FOR RANDOM AS 1 LEN = LEN(drvr)
SEEK 1, 1
DO
GET 1, , drvr
LOOP UNTIL (UCASE$(Manu$) = RTRIM$(UCASE$(drvr.Manuf)) AND UCASE$(Model$) = RTRIM$(UCASE$(drvr.Model))) OR (EOF(1))
IF (EOF(1)) THEN
retFlag = 0
ELSE
retFlag = 1
END IF
CLOSE 1
END SUB
SUB header 'Title Header
CLS
LOCATE , 26: PRINT "Bass enclosure design program"
LOCATE , 22: PRINT "Written by Terry Christopherson, 5/92"
FOR x = 1 TO 80
PRINT CHR$(196);
NEXT x
VIEW PRINT 4 TO 23
END SUB
FUNCTION ltr2cf (ltr!)
ltr2cf = ltr! * .0353
END FUNCTION
FUNCTION Lv! (Dv!, Vb!, Fb!)
Lv! = ((1.463 * (10 ^ 7) * ((Dv! / 2) ^ 2)) / ((Fb! ^ 2) * (Vb! ^ 2))) - (1.436 * (Dv! / 2))
END FUNCTION
SUB makeIsobarik
CLS
LOCATE 12, 35: PRINT "Making Isobarik"
SLEEP 2
END SUB
SUB makePorted
CLS
LOCATE 12, 35: PRINT "Making Ported"
SLEEP 2
END SUB
SUB makeSealed
SHARED resonance AS SINGLE
clrTop
box 8, 15, 12, 64
LOCATE 9, 16: PRINT "Input desired Qtc (.5 to 1.5) for this enclosure"
LOCATE , 17: PRINT "(.5=Overdamped - .707=Max Flat - 1.5=4dB peak)"
LOCATE , 38: INPUT "", Qtc!
clrBottom
box 20, 34, 22, 46
COLOR 19
LOCATE 21, 35: PRINT "Calculating"
SLEEP 2
COLOR 7
encl.Vol = drvr.Vas / Alpha!(Qtc!, drvr.Qts)
resonance! = Fc!(Qtc!, drvr.Qts, drvr.Fs)
encl.Cutoff = F3!(Qtc!, resonance!)
CLS
box 10, 23, 14, 57
LOCATE 11, 27: PRINT USING mask1; "Enclosure Volume -"; encl.Vol; "Cu Ft"
LOCATE , 24: PRINT USING mask2; "Enclosure Resonance -"; resonance; "Hz"
LOCATE , 32: PRINT USING mask2; "-3dB Cutoff -"; encl.Cutoff; "Hz"
clrBottom
box 20, 27, 22, 52
LOCATE 21, 28: PRINT "Print information? (Y/N)"
DO
a$ = INKEY$
LOOP WHILE a$ = ""
SELECT CASE a$
CASE "y", "Y": prtInfo "s", resonance!, Qtc!
CASE "n", "N"
clrBottom
box 20, 27, 22, 53
LOCATE 21, 28: PRINT "Press any key to continue"
DO
b$ = INKEY$
LOOP WHILE b$ = ""
CASE ELSE: entryError
END SELECT
END SUB
SUB matchedData
clrBottom
box 20, 26, 22, 54
COLOR 27
BEEP
LOCATE 21, 27: PRINT "Matches driver in database!"
COLOR 7
SLEEP 2
clrBottom
END SUB
FUNCTION PdB! (Qtc!)
PdB! = 1.30103 * ((Qtc ^ 4) / ((Qtc ^ 2) - .25)) ^ .5
END FUNCTION
SUB prtInfo (type$, resonance!, Qtc!)
clrBottom
box 20, 22, 22, 58
LOCATE 21, 23: PRINT "Press any key when printer is ready"
DO
a$ = INKEY$
LOOP WHILE a$ = ""
LPRINT : LPRINT " Driver: ", drvr.Manuf, drvr.Model
LPRINT USING mask1; " Vas:"; drvr.Vas; "Cu Ft"
LPRINT USING mask1; " Qts:"; drvr.Qts
LPRINT USING mask2; " Fs:"; drvr.Fs; "Hz"
LPRINT : LPRINT " Using"; Qtc!; "Qtc"
LPRINT : LPRINT USING mask1; " Enclosure Volume -"; encl.Vol; "Cu Ft"
LPRINT USING mask2; " Resonant Freqency -"; resonance!; "Hz"
LPRINT USING mask2; " -3dB Cutoff Frequency -"; encl.Cutoff; "Hz"
LPRINT CHR$(10)
END SUB
SUB saveData
OPEN "c:\SPEAKER.DAT" FOR RANDOM AS #1 LEN = LEN(drvr)
DO
GET #1, , oldDrvr
LOOP UNTIL (oldDrvr.Manuf = drvr.Manuf AND oldDrvr.Model = drvr.Model) OR (EOF(1))
IF (EOF(1)) THEN
PUT #1, , drvr
CLOSE #1
another YorN$
ELSE matchedData
END IF
END SUB
SUB showData
CLS
spkrDataBox
LOCATE 7, 36: PRINT drvr.Manuf
LOCATE 8, 36: PRINT drvr.Model
LOCATE 9, 36: PRINT drvr.Size
LOCATE 10, 36: PRINT drvr.Vas
LOCATE 11, 36: PRINT drvr.Qts
LOCATE 12, 36: PRINT drvr.Fs
LOCATE 13, 36: PRINT drvr.PwrRms
DO
clrBottom
box 20, 27, 22, 52
LOCATE 21, 28: PRINT "Use this speaker? (Y/N)"
DO
a$ = INKEY$
LOOP WHILE a$ = ""
SELECT CASE a$
CASE "y", "Y": sysTypeMenu
CASE "n", "N": enterSearchParms
CASE CHR$(27)
CASE ELSE: entryError
END SELECT
LOOP UNTIL UCASE$(a$) = "Y" OR UCASE$(a$) = "N" OR a$ = CHR$(27)
END SUB
SUB spkrDataBox
box 6, 20, 16, 60
LOCATE 7, 22: PRINT "Manufacturer: ";
LOCATE 8, 22: PRINT " Model: ";
LOCATE 9, 22: PRINT " Size: ";
LOCATE 10, 22: PRINT " Vas: ";
LOCATE 10, 43: PRINT "Cu.Ft.";
LOCATE 11, 22: PRINT " Qts: ";
LOCATE 12, 22: PRINT " Fs: ";
LOCATE 13, 22: PRINT " RMS Power: ";
END SUB
SUB storeMenu (yn$, a$)
del$ = CHR$(0) + CHR$(83)
DO
CLS
box 8, 20, 15, 60
LOCATE 9, 24: PRINT "1. S)ave driver to disk"
LOCATE 10, 24: PRINT "2. U)se driver and save to disk"
LOCATE 11, 24: PRINT "3. N)O save but use driver"
LOCATE 13, 22: PRINT "<Delete> Erase driver, re-enter data"
LOCATE 14, 22: PRINT "<Esc> Cancel, back"
Manu$ = drvr.Manuf
Model$ = drvr.Model
DO
a$ = INKEY$
LOOP WHILE a$ = ""
SELECT CASE a$
CASE "1", "s", "S"
saveData
another yn$
IF UCASE$(yn$) = "N" THEN : CLS : END
CASE "2", "u", "U"
saveData
sysTypeMenu
another yn$
IF UCASE$(yn$) = "N" THEN : CLS : END
CASE "3", "n", "N"
sysTypeMenu
another yn$
IF UCASE$(yn$) = "N" THEN : CLS : END
CASE CHR$(27)
CASE del$
CASE ELSE: entryError
END SELECT
LOOP UNTIL a$ = "1" OR a$ = "2" OR a$ = "3" OR a$ = CHR$(27) OR a$ = del$ OR yn$ = "Y" OR yn$ = "y"
END SUB
SUB sysTypeMenu
DO
CLS
box 9, 29, 15, 50
LOCATE 10, 30: PRINT "1. S)ealed System"
LOCATE , 30: PRINT "2. V)ented System"
LOCATE , 30: PRINT "3. I)sobarik System"
LOCATE 14, 32: PRINT "<Esc> to cancel"
DO
a$ = INKEY$
LOOP WHILE a$ = ""
SELECT CASE a$
CASE "1", "S", "s": makeSealed
CASE "2", "V", "v": makePorted
CASE "3", "I", "i": makeIsobarik
CASE CHR$(27)
CASE ELSE: entryError
END SELECT
LOOP UNTIL a$ = CHR$(27)
END SUB
SUB tryToFit
CLS
PRINT "Try to fit"
END SUB
FUNCTION Vb! (Vas!, Alpha!)
Vb! = Vas! / Alpha!
END FUNCTION